Attribute VB_Name = "Module1"
Public Machine_Location As String

Public RegionConst As String
Public DistrictConst As String
Public SiteCodeConst As String
Public OutreachCodeConst As String
Public OutreachVar As String
Public OrganizationString As String

Public ClientAddress As String
Public PartnerAddress As String

Public Const AppExitCodeConst = "k4HvE5zRg4W" ' the MAGIC NUMBER to make the app exit
Public Const AppTrainCodeConst = "F2kT62Le9z4"    ' the MAGIC NUMBER to redirect the app to the trainingdata database
Public Const AppSetLocationConst = "i4ft3D7w0" ' the MAGIC NUMBER to bring up the screen to set the computer location

Public ConnectString As String
Public ORGANIZATION As String

Public CnUser As New Connection
Public RsUser As New Recordset
Public Cmd As New Command

Public Global_Error_Msg As String

Public UserFirst As String * 25
Public UserLast As String * 25
Public UserPwd As String * 6
Public COUNCODE As String
Public Pat_Barcode_Str As String

'added for MACRO
Public NextClientCode As Long
Public NextCoupleCode As Long
'Public NewNextClientCode As Long
'Public NewNextCoupleCode As Long

Public REGION As String
Public DISTRICT As String
Public SITE As String
Public VDATE As String


Public VISITID As Long
Public SESSTYPE As String
Public Sex As String
Public RETURNV As String
Public NEWCODE As String
Public CLIENTCO As String 'this one
Public COUPCODE As String
Public PARTCODE As String

Public VISITTYP As String
'1 = Full VCT
'2 = Counseling Only
'3 = Clinic Only

Public P_VISITID As Long
Public P_SESSTYPE As String
Public P_SEX As String
Public P_RETURNV As String
Public P_NEWCODE As String
Public P_CLIENTCO As String
Public P_COUPCODE As String
Public P_PARTCODE As String

'Variables for the lab
Public TEST1NAME As String
Public TEST2NAME As String
Public TEST3NAME As String
Public Test1Result As String
Public Test2Result As String
Public Test3Result As String
Public HIV As String

'Variables for the demographic section
Public COUPTYPE As String
Public Age As String
Public RESCLASS As String
Public GROUPSES As String
Public EMPLOYED As String
Public OCCUPAT As String
Public EDUEXPE As String
Public MARSTAT As String
Public MARTYPE As String
Public MARHIST As String
Public KNOWUS1 As String
Public KNOWUS2 As String
Public KNOWUS3 As String
Public KNOWUS4 As String
Public KNOWUS5 As String
Public KNOWUS6 As String
Public KNOWUS7 As String
Public KNOWUS8 As String
Public KNOWUS98 As String
Public KNOWUS99 As String
Public REFERBY As String
Public REASHERE As String

'Variables for the Sexual History section
Public PRTESTED As String
Public TMONTH As String
Public TYEAR As String
Public PRTESITE As String
Public EVERHAD As String
Public LIFEPART As String
Public SMONTH As String
Public SYEAR As String
Public EVERAPED As String
Public PREG As String
Public TRANSFUS As String
Public PART6MO As Integer
Public STISYMPT As String
Public TBSYMPT As String
Public REFERRED As String

'variables for the posttest section
Public DISCOR As String
Public RRPLAN0 As String
Public RRPLAN1 As String
Public RRPLAN2 As String
Public RRPLAN3 As String
Public RRPLAN4 As String
Public RRPLAN5 As String
Public RRPLAN6 As String
Public RRPLAN7 As String
Public RRPLAN8 As String
Public RRPLAN9 As String
Public RRPLAN10 As String
Public RRPLAN11 As String
Public RRPLAN12 As String
Public RRPLAN99 As String
Public REFTO0 As String
Public REFTO1 As String
Public REFTO2 As String
Public REFTO3 As String
Public REFTO4 As String
Public REFTO5 As String
Public REFTO6 As String
Public REFTO7 As String
Public REFTO8 As String
Public REFTO9 As String 'Lighthouse
Public REFTO10 As String ' Lighthouse
Public REFTO11 As String ' Lighthouse
Public REFTO98 As String
Public REFTO99 As String
Public COUNSELD As String
Public GAVETEST As String
Public GAVERESU As String
Public COUNCOND As String
Public LABTECH As String

'Variables for the 4 most recent sex partners in the last 6 months
Public CurrPartner As Integer
Public RecentPartnerDetails As String
Public PTYPE(3) As String
Public PNEW(3) As String
Public PSTATUS(3) As String
Public PLTSTMO(3) As String
Public PLTSTYR(3) As String
Public PFPMETH(3) As String
Public PCONUSE(3) As String
Public PCONLST(3) As String

'variables for the clinic section
Public STID1 As String
Public STID2 As String
Public STID3 As String
Public STID4 As String
Public STID5 As String
Public STID6 As String
Public STID7 As String
Public STIT1 As String
Public STIT2 As String
Public STIT3 As String
Public STIT4 As String
Public STIT5 As String
Public STIT6 As String
Public STIT7 As String
Public CLINCOND As String
Public PRINTED As String

Public TIMEPOST As String

Public Machine_Id As String

Public Const Version_Const = "6.40"

'Code for synchronizing the client clocks with the server
Public Type SystemTime
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

'MACRO
'Public Const ConnectStringForRealData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=192.168.1.200;PORT=3306;DATABASE=macro;USER=meduser;PASSWORD=letmein;OPTION=3;"
'Public Const ConnectStringForTrainingData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=192.168.1.200;PORT=3306;DATABASE=training;USER=meduser;PASSWORD=letmein;OPTION=3;"

'LIGHTHOUSE
'Public Const ConnectStringForRealData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=192.168.1.169;PORT=3306;DATABASE=vct;USER=meduser;PASSWORD=letmein;OPTION=3;"
'Public Const ConnectStringForTrainingData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=192.168.1.169;PORT=3306;DATABASE=vcttraining;USER=meduser;PASSWORD=letmein;OPTION=3;"

'Localhost
   Public Const ConnectStringForRealData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=localhost;PORT=3306;DATABASE=vct;USER=baobab;PASSWORD=baobab;OPTION=3;"
   Public Const ConnectStringForTrainingData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=localhost;PORT=3306;DATABASE=vct;USER=baobab;PASSWORD=baobab;OPTION=3;"

'Public Const ConnectStringForRealData = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\macro.mdb;Persist Security Info=False"

'Public Const ConnectStringForRealData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=192.168.1.169;PORT=3306;DATABASE=vct;USER=meduser;PASSWORD=letmein;OPTION=3;"
'Public Const ConnectStringForRealData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=127.0.0.1;PORT=3306;DATABASE=vct;USER=meduser;PASSWORD=letmein;OPTION=3;"
'Public Const ConnectStringForTrainingData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=192.168.1.169;PORT=3306;DATABASE=vcttraining;USER=meduser;PASSWORD=letmein;OPTION=3;"
'Public Const ConnectStringForRealData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=192.168.1.200;PORT=3306;DATABASE=macro;USER=meduser;PASSWORD=letmein;OPTION=3;"
'Public Const ConnectStringForTrainingData = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=192.168.1.200;PORT=3306;DATABASE=training;USER=meduser;PASSWORD=letmein;OPTION=3;"
'Public Const ConnectStringForRealData = "Driver={MySQL ODBC 3.51 Driver};Server=192.168.1.200;database=macro;uid=macrousr;pwd=letmein"
'Public Const ConnectStringForTrainingData = "Driver={MySQL ODBC 3.51 Driver};Server=192.168.1.7;database=training;uid=macrousr;pwd=letmein"


'declarations start here for the raw printing
Public Type DOCINFO
          pDocName As String
          pOutputFile As String
          pDatatype As String
      End Type

      Public Declare Function ClosePrinter Lib "winspool.drv" (ByVal _
         hPrinter As Long) As Long
      Public Declare Function EndDocPrinter Lib "winspool.drv" (ByVal _
         hPrinter As Long) As Long
      Public Declare Function EndPagePrinter Lib "winspool.drv" (ByVal _
         hPrinter As Long) As Long
      Public Declare Function OpenPrinter Lib "winspool.drv" Alias _
         "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
          ByVal pDefault As Long) As Long
      Public Declare Function StartDocPrinter Lib "winspool.drv" Alias _
         "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
         pDocInfo As DOCINFO) As Long
      Public Declare Function StartPagePrinter Lib "winspool.drv" (ByVal _
         hPrinter As Long) As Long
      Public Declare Function WritePrinter Lib "winspool.drv" (ByVal _
         hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, _
         pcWritten As Long) As Long
'declarations end here for the raw printing

' Using this API call allows control over how rounded the corners of the rectangle are.
' This is better than just using the shape control.
Public Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As Long
Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Declare Function CreatePen Lib "gdi32.dll" (ByVal fnPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Declare Function CreateHatchBrush Lib "gdi32.dll" (ByVal nIndex As Long, ByVal crColor As Long) As Long


Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal _
lpBuffer As String, nSize As Long) As Long

Declare Function SetLocalTime Lib "kernel32.dll" (lpSystemTime As SystemTime) As Long

Declare Function Escape Lib "gdi32" (ByVal hdc As Long, ByVal Esc As Long, ByVal ncount As Long, ByVal InData As String, ByVal outdata As Any) As Long

'Public Enum HookFlags
'    HFKeyDown = 8
'End Enum

Declare Function ExitWindowsEx Lib "user32" (ByVal uflags As Long, _
   ByVal DwReserved As Long) As Boolean

Public Const EWX_SHUTDOWN = 1

'Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
'Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
'Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
'Private Declare Function GetForegroundWindow& Lib "user32" ()
'Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
'Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout As Long)
'Private Declare Function MapVirtualKeyEx Lib "user32" Alias "MapVirtualKeyExA" (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
'Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

'\\ Memory manipulation routines
'Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'\\ Pointer validation in StringFromPointer
'Declare Function IsBadStringPtrByLong Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long


'Type EVENTMSG
'    wMsg As Long
'    lParamLow As Long
'    lParamHigh As Long
'    ' msgTime As Long
'    ' hWndMsg As Long
'    End Type
'Dim EMSG As EVENTMSG
'Dim hHook As Long, frmHooked As Form, hFlags As Long

'Private Function Window_SetAlwaysOnTop(hwnd As Long, bAlwaysOnTop As Boolean) As Boolean
'    Window_SetAlwaysOnTop = SetWindowPos(hwnd, -2 - bAlwaysOnTop, 0, 0, 0, 0, SWP_NOREDRAW Or SWP_NOSIZE Or SWP_NOMOVE)
'End Function

'Public Sub SetHook(fOwner As Form, flags As HookFlags)
'    hHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf HookProc, 0, 0)
'    Set frmHooked = fOwner
'    hFlags = flags
'    Window_SetAlwaysOnTop frmHooked.hwnd, True
'End Sub

'Public Sub RemoveHook()
'    UnhookWindowsHookEx hHook
'    Window_SetAlwaysOnTop frmHooked.hwnd, False
'    Set frmHooked = Nothing
'End Sub

'Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'   If nCode < 0 Then
'      HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
'      Exit Function
'   End If
'   Dim I%, J%, k%
'   CopyMemory EMSG, ByVal lParam, Len(EMSG)
'   Select Case EMSG.wMsg
'      Case WM_KEYDOWN
'      If (hFlags And HFKeyDown) = HFKeyDown Then
'         If GetAsyncKeyState(vbKeyShift) Then J = 1
'         If GetAsyncKeyState(vbKeyControl) Then J = 2
'         If GetAsyncKeyState(vbKeyMenu) Then J = 4
'
'         Select Case (EMSG.lParamLow And &HFF)
'            Case 0 To 31, 90 To 159
'            k = (EMSG.lParamLow And &HFF)
'            Case Else
'            k = MapVirtualKeyEx(EMSG.lParamLow And &HFF, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))
'         End Select
'         frmHooked.System_KeyDown k, J
'      End If
'   End Select
'   Call CallNextHookEx(hHook, nCode, wParam, lParam)
'End Function

Public Function UpdateLog(User As String, Action As String, Memo As String, Machine As String)
   CnUser.Open ConnectStringForRealData
   Cmd.CommandText = "Insert Audit_Log Values ('" & _
                     User & "','" & _
                     Date & " " & Time & "','" & _
                     Action & "','" & _
                     Memo & "','" & _
                     Machine & "')"
   Cmd.CommandType = adCmdText
   Cmd.Name = "AddAuditLog"
   Cmd.ActiveConnection = CnUser
   Cmd.Execute
   CnUser.Close
End Function

Public Sub SetNewTime(NewDateTime As String)
   ' Set the system time with Hours, Minutes, Seconds
   Dim SetTime As SystemTime
   Dim retval As Long

   SetTime.wHour = Hour(NewDateTime)
   SetTime.wMinute = Minute(NewDateTime)
   SetTime.wSecond = Second(NewDateTime)
   SetTime.wMilliseconds = 0
   SetTime.wDay = Day(NewDateTime)
   SetTime.wMonth = Month(NewDateTime)
   SetTime.wYear = Year(NewDateTime)

   ' Set time and date.
   retval = SetLocalTime(SetTime)
End Sub

Public Function TrimStr(ByVal N As Double) As String
   TrimStr = RTrim(LTrim(Str(N)))
End Function

Public Function TrimAll(ByVal S As String) As String
   TrimAll = RTrim(LTrim(S))
End Function


'Public Function Next_Pat_Num() As String
'
'   Dim TempNum As String
'
'   'find the largest patient number used so far for this year
'   CnUser.Open ConnectString
'   Cmd.CommandText = "SELECT MAX(Pat_ID)" _
'                  & " From   MasterPatientRecord" _
'                  & " Where  Site_ID = '" & Site_ID_Const & "'"
'   Cmd.CommandType = adCmdText
'   Cmd.ActiveConnection = CnUser
'   RsUser.Open Cmd, , adOpenStatic
'   TempNum = LTrim(RTrim(Str(RsUser(0) + 1)))
'   RsUser.Close
'   CnUser.Close
'   While Len(TempNum) < 6
'      TempNum = "0" & TempNum
'   Wend
'   Next_Pat_Num = TempNum
'
'End Function


Public Function Next_VISITID() As Long

   'find the largest VISITID number used so far
   CnUser.Open ConnectString
   Cmd.CommandText = "SELECT MAX(VISITID)" _
                  & " FROM   client"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   RsUser.Open Cmd, , adOpenStatic
   If IsNull(RsUser(0)) Then
      Next_VISITID = 1
   Else
      Next_VISITID = RsUser(0) + 1
   End If
   RsUser.Close
   CnUser.Close

End Function

'Function Formatted_Pat_ID(Pat_ID_Par As String) As String
'   Formatted_Pat_ID = Left(Pat_ID_Par, 2) & "-" & Mid(Pat_ID_Par, 3, 4) & "-" & Right(Pat_ID_Par, 3)
'End Function

Function StringDate() As String
   Dim CurDate As String
   Dim TempStringDate As String
   
   CurDate = Date 'gets the system date
   TempStringDate = Day(CurDate) & "-" & MonthName(Month(CurDate), True) & "-" & Year(CurDate)
   While Len(TempStringDate) < 11
      TempStringDate = "0" & TempStringDate
   Wend
   StringDate = TempStringDate
End Function

Function VCTDate() As String
   Dim CurDate As String
   Dim CurDay As String
   Dim CurMonth As String
   Dim curyear As String
   
   CurDate = Date 'gets the system date
   CurDay = Day(CurDate)
   If Len(CurDate) < 2 Then
      CurDate = "0" & CurDate
   End If
   CurMonth = Month(CurDate)
   If Len(CurMonth) < 2 Then
      CurMonth = "0" & CurMonth
   End If
   VCTDate = CurDay & " / " & CurMonth & " / " & Year(CurDate)
End Function

'Function CheckTableExists()
'
'   'Check to see if the table exists and create it if not
'   CnUser.Open ConnectString
'   Cmd.CommandText = "Select  name" _
'                  & " From    sysobjects" _
'                  & " where   name = 'MasterPatientRecord'"
'   Cmd.CommandType = adCmdText
'   Cmd.ActiveConnection = CnUser
'   RsUser.Open Cmd, , adOpenStatic
'   If RsUser.EOF = True Then
'      'MsgBox ("Table 1 is missing!!!!!")
'      found = False
'   Else
'      'MsgBox ("Table 1 is ok")
'      found = True
'   End If
'   RsUser.Close
'   CnUser.Close
'
'   If found = False Then
'      CnUser.Open ConnectString
'      Cmd.CommandText = "CREATE TABLE dbo.MasterPatientRecord " & _
'      "(First_Name NVARCHAR(15), " & _
'      "Last_Name NVARCHAR(15), " & _
'      "Sex CHAR(1), " & _
'      "Day_Of_Birth CHAR(2), " & _
'      "Month_Of_Birth CHAR(2), " & _
'      "Year_Of_Birth CHAR(4), " & _
'      "Birth_TA NVARCHAR(50), " & _
'      "Location FLOAT, " & _
'      "Address NVARCHAR(50), " & _
'      "Site_ID CHAR(3), " & _
'      "Pat_ID FLOAT, " & _
'      "Birth_Date CHAR(11), " & _
'      "Date_Reg CHAR(11), " & _
'      "Reg_By CHAR(6), " & _
'      "PRIMARY KEY (Site_ID, Pat_ID))"
'
'      Cmd.CommandType = adCmdText
'      Cmd.ActiveConnection = CnUser
'      Cmd.Execute
'      CnUser.Close
'
'      'Add the first record
'      CnUser.Open ConnectString
'      Cmd.ActiveConnection = CnUser
'
'      CnUser.Execute "Insert Into MasterPatientRecord Values('Test', 'Patient', 'M', '18','04', '1962', 'Birth TA', 0, 'Address', '101', '900000', '18-APR-1962', '18-APR-1962', '782472')"
'
'      CnUser.Close
'   End If
'
'
'End Function

'Public Function FileExists(ByVal sFileName As String) As Boolean
'
'    Dim sFile As String
'
'    On Error Resume Next
'
'    FileExists = False
'
'    sFile = Dir$(sFileName)
'    If (Len(sFile) > 0) And (Err = 0) Then
'        FileExists = True
'    End If
'
'End Function

Function PrintRect(ByVal x, y, w, H)
   Printer.Line (x, y)-Step(w, 0) 'top
   Printer.Line (x, y + H)-Step(w, 0) 'bottom
   Printer.Line (x, y)-Step(0, H) 'left
   Printer.Line (x + w, y)-Step(0, H) 'right
End Function


Public Function PrintLabel(ByVal Par_SiteCode As String, ByVal Par_OutreachCode As String, ByVal Par_ClntCode As String, ByVal Par_Sex) As Integer
   
   Dim TempLongVar As Double

   'these are for raw writing
   Dim NewPtr As Printer
   Dim sWrittenData As String
   Dim lhPrinter As Long
   Dim lReturn As Long
   Dim lpcWritten As Long
   Dim lDoc As Long
   Dim MyDocInfo As DOCINFO
   
   Dim BarCodeString As String
   Dim BarCodeHexString As String
   
   BarCodeString = Par_ClntCode
   While Len(BarCodeString) < 7
      BarCodeString = "0" & BarCodeString
   Wend
   BarCodeString = Par_OutreachCode & BarCodeString
   BarCodeString = Par_SiteCode & BarCodeString
   'TempLongVar = Val(BarCodeString)
   BarCodeHexString = HexVal(BarCodeString)
'BarCodeString = ""
'BarCodeString = Hex2Dec(BarCodeHexString)

   'Print the label
   For Each NewPtr In Printers
      If NewPtr.DeviceName = "TLP2844" Then
         Set Printer = NewPtr

         'this is where the raw stuff starts
         lReturn = OpenPrinter(Printer.DeviceName, lhPrinter, 0)
         If lReturn = 0 Then
             MsgBox "The Printer Name you typed wasn't recognized."
             Exit Function
         End If
         MyDocInfo.pDocName = "Label"
         MyDocInfo.pOutputFile = vbNullString
         MyDocInfo.pDatatype = vbNullString
         lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo)
         Call StartPagePrinter(lhPrinter)
         sWrittenData = Chr(10) & "N" & Chr(10) & _
                         "A160,25,0,2,2,2,N," & Chr(34) & "Site:     " & Par_SiteCode & Chr(34) & Chr(10) & _
                         "A160,75,0,2,2,2,N," & Chr(34) & "Outreach: " & Par_OutreachCode & Chr(34) & Chr(10) & _
                         "A160,125,0,2,2,2,N," & Chr(34) & "Client:   " & Par_ClntCode & " (" & Par_Sex & ")" & Chr(34) & Chr(10) & _
                         "A160,175,0,2,2,2,N," & Chr(34) & "Date:     " & StringDate & Chr(34) & Chr(10) & _
                         "B160,225,0,3,3,9,120,N," & Chr(34) & BarCodeHexString & Chr(34) & Chr(10) & _
                         "P1" & Chr(10) & _
                         "N" & vbFormFeed

         lReturn = WritePrinter(lhPrinter, ByVal sWrittenData, Len(sWrittenData), lpcWritten)
         lReturn = EndPagePrinter(lhPrinter)
         lReturn = EndDocPrinter(lhPrinter)
         lReturn = ClosePrinter(lhPrinter)
      End If
   Next
End Function

Public Function HexVal(TheNum As String) As String
'This turns the Site code, outreach code and client code into hex for compression

   Dim TempNum As Double
   Dim TempHex As String
   Dim TempChar As String
   Dim IntPart As Double
   
   TempHex = ""
   TempNum = Val(TheNum)
   Do
      IntPart = Int(TempNum / 16)
      TempChar = TrimAll(Str(TempNum - (IntPart * 16)))
      TempNum = Int(TempNum / 16)
      Select Case TempChar
         Case "0"
            TempHex = "0" & TempHex
         Case "1"
            TempHex = "1" & TempHex
         Case "2"
            TempHex = "2" & TempHex
         Case "3"
            TempHex = "3" & TempHex
         Case "4"
            TempHex = "4" & TempHex
         Case "5"
            TempHex = "5" & TempHex
         Case "6"
            TempHex = "6" & TempHex
         Case "7"
            TempHex = "7" & TempHex
         Case "8"
            TempHex = "8" & TempHex
         Case "9"
            TempHex = "9" & TempHex
         Case "10"
            TempHex = "A" & TempHex
         Case "11"
            TempHex = "B" & TempHex
         Case "12"
            TempHex = "C" & TempHex
         Case "13"
            TempHex = "D" & TempHex
         Case "14"
            TempHex = "E" & TempHex
         Case "15"
            TempHex = "F" & TempHex
      End Select
   Loop While Int(TempNum) > 0
   HexVal = TempHex
End Function

Function Hex2Dec(ByVal HexString As String) As Variant
'This turns the hex barcode on the VCT label back into text
  Dim x As Integer
  Dim BinStr As String
  If Left$(HexString, 2) Like "&[hH]" Then
    HexString = Mid$(HexString, 3)
  End If
  If Len(HexString) <= 23 Then
    Const BinValues = "0000000100100011" & _
                      "0100010101100111" & _
                      "1000100110101011" & _
                      "1100110111101111"
    For x = 1 To Len(HexString)
      BinStr = BinStr & Mid$(BinValues, _
               4 * Val("&h" & Mid$(HexString, x, 1)) + 1, 4)
    Next
    Hex2Dec = CDec(0)
    For x = 0 To Len(BinStr) - 1
      Hex2Dec = Hex2Dec + Val(Mid(BinStr, _
                Len(BinStr) - x, 1)) * 2 ^ x
    Next
  Else
    ' Number is too big, handle error here
  End If
End Function

Function GetNextClientCode() As Long
'This function selects the larges number in the CLNTCODE field of the Client table and adds 1 to it
   CnUser.Open ConnectString
   Cmd.CommandText = "SELECT MAX(CLNTCODE)" _
                  & " FROM   client" _
                  & " WHERE SITE = '" & SiteCodeConst & "'"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   RsUser.Open Cmd, , adOpenStatic
   If IsNull(RsUser(0)) Then
      GetNextClientCode = 1
   Else
      GetNextClientCode = RsUser(0) + 1
   End If
   RsUser.Close
   CnUser.Close

End Function

Function GetNextCoupleCode() As Long

'This function selects the largest number in the COUPCODE field of the Client table and returns 1 greater
   CnUser.Open ConnectString
   Cmd.CommandText = "SELECT MAX(COUPCODE)" _
                  & " FROM   client" _
                  & " WHERE SITE = '" & SiteCodeConst & "'"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   RsUser.Open Cmd, , adOpenStatic
   If IsNull(RsUser(0)) Then
      GetNextCoupleCode = 1
   Else
      GetNextCoupleCode = RsUser(0) + 1
   End If
   RsUser.Close
   CnUser.Close

End Function
